Predikce Cen Nemovitostí

load('ondra_makro_promenne.Rdata')

join_list <- function(list){
  tbl_res <- list[[1]]
  for(i in 2:length(list)) tbl_res <- inner_join(tbl_res, list[[i]], by = 'date')
  return(tbl_res)
}

tbl_final <- join_list(var_list)

Tabulka makro-dat

Následující tabulka obsahuje makro-proměnné, tedy zatím neobsahuje dílčí ceny domů, které jsi chtěl v zadání. Jsou to tedy:

• HDP měřeno v USD
• hypoteční sazba pdle ČNB, zdroj https://www.cnb.cz/cnb/stat.ARADY_PKG.PARAMETRY_SESTAVY?p_strid=AAABAD&p_sestuid=60261&p_lang=CS
• inflace měřená CPI, všchny produkty
• mediánová mzda, všechna odvětví
• míra nezaměstnanosti, všechna odvětví
• index cen rezidenčních nemovitostí

Kromě dat z ČNB pochází ze St.Louis FRED, ten je bere všude možně (OECD, Eurostat), používám protože se z něho jednoduše tahají data.

tbl_final

Graf proměnných převedených na index se základním rokem 2010

U některých proměnných to moc nemá smysl, zejména u úrokových měr, které se dost skokově mění a zároveň nerostou v absolutních číslech stabilně, jako např. HDP které roste v čase konstantně. Nicméně tu je graf:

tbl_final %>% 
  mutate(gdp = (gdp/tbl_final$gdp[which(tbl_final$date == '2010-01-01')])*100,
         inflation = (inflation/tbl_final$inflation[which(tbl_final$date == '2010-01-01')])*100,
         wage_med = (wage_med/tbl_final$wage_med[which(tbl_final$date == '2010-01-01')])*100,
         unemp = (unemp/tbl_final$unemp[which(tbl_final$date == '2010-01-01')])*100,
         hypo = (hypo/tbl_final$hypo[which(tbl_final$date == '2010-01-01')])*100) %>% 
  drop_na(.) %>% 
  pivot_longer(data = .,
               cols = -date,
               names_to = 'variable',
               values_to = 'value') %>% 
  ggplot(data = .,
         aes(x = date, y = value, color = variable)) + geom_line() +
  scale_y_continuous(name = 'Index, základ 01/2010 = 100') +
  ggtitle('Vývoj indexu jednotlivých proměnných') +
  scale_x_date(date_breaks = '1 years') +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) -> plot_index


ggplotly(plot_index)

differentiate <- function(x){
  ser_new = vector(mode = 'numeric', length = length(x))
  for(i in 2:length(x)) ser_new[i] = x[i] - x[i - 1]
  return(ser_new)
}

Graf temp růstu

Nejsmysluplnější je graf tempa růstu (ten ale má smysl sledovat jen v krátkých obdobích). Pro percentuální proměnné se jedná o jednoduché diference: \(x_t^{diff} = x_t - x_{t - 1}\) Pro absolutní proměnné se jedná o tempo růstu.

tbl_final %>% 
  mutate(gdp = 100*(log(gdp) - lag(log(gdp))),
         inflation = inflation - lag(inflation),
         wage_med = wage_med - lag(wage_med),
         unemp = unemp - lag(unemp),
         hypo = hypo - lag(hypo),
         houseprice = houseprice - lag(houseprice)) %>% 
  drop_na() %>% 
  pivot_longer(data = .,
               cols = -date,
               names_to = 'variable',
               values_to = 'value') %>% 
  ggplot(data = .,
         aes(x = date, y = value, color = variable)) + geom_line() +
  scale_y_continuous(name = 'Rel. zmena, pct.') +
  scale_x_date(date_breaks = '1 years',
               date_minor_breaks = '6 months') +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
  ggtitle('Relativni zmeny sledovanych velicin') -> plot_rel_change

ggplotly(plot_rel_change)

Jednoduchá predikce

Podle mě nemá moc smysl chtít něco vyloženě vyčíst z grafu. Tohle je jednoduchý model založený na vzájemné provázanosti všech proměnných. Nejde totiž říct, že růst jedné proměnné vždy jednoznačně předpoví růst cen nemovitostí, což asi ani nepředpokládáš. Předpověď jsem nastavil na 6 kvartálů dopředu (tak jak jsi chtěl v mailu).

Když se podíváš na jednotlivé proměnné, řádky značí další kvartál v pořadí. Sloupce mají následující význam:

• fcst je střední hodnota předpovědi
• lower je spodní odhad - šance že bude nižší je podle modelu 5%
• upper je horní odhad - analogicky vyšší nebude v 95% případů
• CI udává celkovou šířku tohoto 90% spolehlivostního intervalu

Ber to samozřejmě všechno s rezervou, pořád mi to ale přijde rozumnější, než na základě grafů chtít něco předpovídat. Až budu mít víc granurální data k cenám nemovitostí, tak ten model ještě upravím trochu.

tbl_final %>% 
  mutate(gdp = 100*(log(gdp) - lag(log(gdp))),
         inflation = inflation - lag(inflation),
         wage_med = wage_med - lag(wage_med),
         unemp = unemp - lag(unemp),
         hypo = hypo - lag(hypo),
         houseprice = houseprice - lag(houseprice)) %>% 
  drop_na() %>% 
  dplyr::select(-date) %>% 
  VAR(y = ., 
      p = 2,
      type = 'const',
      season = NULL,
      exog = NULL) -> var_model

  predict(var_model, n.ahead = 6, CI = 0.95) -> var_prediction
  fanchart(var_prediction, main = c('gdp', 'wage_med', 'hypo', 'unemp', 'inflation', 'houseprice'))

var_prediction

## $gdp
##            fcst     lower    upper       CI
## [1,]  2.3064172 -1.052785 5.665619 3.359202
## [2,]  1.5428368 -2.440803 5.526477 3.983640
## [3,] -0.1963752 -4.333140 3.940390 4.136765
## [4,]  0.9420198 -3.345629 5.229669 4.287649
## [5,]  1.1005595 -3.213250 5.414369 4.313810
## [6,]  0.6743535 -3.647108 4.995815 4.321462
## 
## $hypo
##             fcst      lower     upper        CI
## [1,] -0.08636811 -0.4187047 0.2459685 0.3323366
## [2,] -0.05067688 -0.4490383 0.3476845 0.3983614
## [3,] -0.14281472 -0.5575860 0.2719566 0.4147713
## [4,] -0.23217483 -0.6517741 0.1874244 0.4195992
## [5,] -0.22453580 -0.6515864 0.2025148 0.4270506
## [6,] -0.20601114 -0.6381277 0.2261054 0.4321166
## 
## $inflation
##          fcst       lower    upper       CI
## [1,] 1.150867 -0.11569123 2.417424 1.266558
## [2,] 1.350739  0.01732924 2.684149 1.333410
## [3,] 1.464399  0.02750332 2.901295 1.436896
## [4,] 1.617970  0.15230065 3.083639 1.465669
## [5,] 1.416879 -0.11035913 2.944117 1.527238
## [6,] 1.588434  0.04634742 3.130520 1.542086
## 
## $wage_med
##          fcst      lower    upper       CI
## [1,] 3.096527  0.4417526 5.751302 2.654775
## [2,] 4.260478  0.9757614 7.545195 3.284717
## [3,] 2.772839 -0.9334547 6.479132 3.706293
## [4,] 4.118894  0.3605922 7.877197 3.758302
## [5,] 4.203972  0.3617888 8.046155 3.842183
## [6,] 4.111532  0.2300049 7.993060 3.881527
## 
## $unemp
##            fcst     lower      upper        CI
## [1,] -0.6742368 -1.227547 -0.1209263 0.5533105
## [2,] -0.8073121 -1.479925 -0.1346987 0.6726133
## [3,] -0.5664583 -1.339185  0.2062682 0.7727265
## [4,] -0.3564607 -1.164863  0.4519413 0.8084020
## [5,] -0.3349970 -1.181963  0.5119691 0.8469661
## [6,] -0.3361590 -1.204140  0.5318217 0.8679807
## 
## $houseprice
##          fcst    lower    upper       CI
## [1,] 8.849989 6.681855 11.01812 2.168133
## [2,] 8.110672 5.193693 11.02765 2.916980
## [3,] 7.410599 3.982864 10.83834 3.427736
## [4,] 7.705029 3.664012 11.74605 4.041017
## [5,] 8.049594 3.568439 12.53075 4.481155
## [6,] 8.282038 3.446817 13.11726 4.835221